perm filename CON4[AM,DBL]1 blob
sn#166105 filedate 1975-07-04 generic text, type T, neo UTF8
(FILECREATED " 4-JUL-75 17:41:22" <LENAT>CON4.;3 52373
changes to: VIEW CONCEPTS
previous date: " 3-JUL-75 14:36:28" <LENAT>CON4.;1)
(LISPXPRINT (QUOTE CON4COMS)
T T)
[RPAQQ CON4COMS
((FNS BAG CLASS INIT-C OSET PAIR STRUC VECTOR)
CONCEPTS
(VARS * CONCEPTS)
FACETS
(VARS * FACETS)
(FNS * FACETS)
AUX-FACETS
(VARS * AUX-FACETS)
SUF-PARTS STRATEGY-PARTS XEQ-PARTS XS-PARTS OR-PARTS [COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
CONCEPTS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
FACETS]
[COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
AUX-FACETS]
(P (INIT-C))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA VECTOR STRUC PAIR OSET CLASS BAG)
(NLAML WORTH VIEW UP SUGG SPEC RESTRUC OPS INV INTU INT-NOT INT INIT GENL FILLIN2 FILLIN1
FILLIN EXS-NOT-BDY EXS-NOT EXS-BDY EXS DEFN-NOT DEFN D-R CHECK2 CHECK1 CHECK ANAS
ALGS]
(DEFINEQ
(BAG
[NLAMBDA X
(CONS (QUOTE BAG)
X])
(CLASS
[NLAMBDA X
(CONS (QUOTE CLASS)
X])
(INIT-C
[LAMBDA (R1)
(MOVD (QUOTE OR)
(QUOTE ANY-OF))
(MOVD (QUOTE GETP)
(QUOTE FGETB))
(MOVD (QUOTE APPLY*)
(QUOTE APPLYB))
(MOVD (QUOTE APPEND)
(QUOTE ALL-OF))
(MOVD (QUOTE CAR)
(QUOTE IPRED))
(MOVD (QUOTE CADR)
(QUOTE IDEF))
(MOVD (QUOTE CAR)
(QUOTE PINT))
(MOVD (QUOTE CADR)
(QUOTE P-OP))
(MOVD (QUOTE CADDR)
(QUOTE P-B))
(MOVD (QUOTE CADDDR)
(QUOTE P-P))
(MOVD (QUOTE CADDR)
(QUOTE IVAL))
(MOVD (QUOTE CDDR)
(QUOTE IFEATURES))
(MOVD (QUOTE CADR)
(QUOTE IFEA))
(MOVD (QUOTE CAAR)
(QUOTE CSINT))
(MOVD (QUOTE CDR)
(QUOTE CSOTHERS))
(MOVD (QUOTE CAR)
(QUOTE CSBEST))
(MOVD (QUOTE CAR)
(QUOTE CINT))
(MOVD (QUOTE CADR)
(QUOTE COP))
(MOVD (QUOTE CADDR)
(QUOTE CB))
(MOVD (QUOTE CADDDR)
(QUOTE CP))
(MOVD (QUOTE CDR)
(QUOTE CACT))
(SETQ HCON (HARRAY 503))
(SETQ RANU (QUOTE DOUG))
(SETQ RANC (QUOTE ANYB))
(SETQQ RANF RAND-USER)
(SETQ CIRC (HARRAY 500))
(PUTHASH (QUOTE RAND-OBJ)
(QUOTE RAND-USER)
CIRC)
(PUTHASH (QUOTE RAND-USER)
(QUOTE RAND-CON)
CIRC)
(PUTHASH (QUOTE RAND-CON)
(QUOTE RAND-OBJ)
CIRC)
(SETQ OBJX (EXS OBJECT))
[MAPC CONCEPTS (FUNCTION (LAMBDA (B)
(PUTHASH B 1 HCON)
(PUTD B (COPY TRIVB))
(DEFB B]
[MAP (SETQ R1 (RAND-PERMUTE CONCEPTS))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC]
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC)
[MAP (SETQ R1 (RAND-PERMUTE USERNAMES))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC]
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC)
(PRIN1 "THE NUMBER OF CONCEPTS IS ")
(PRINT (LENGTH CONCEPTS))
(SETQ SUF1 (HARRAY 60))
(SETQ SUF2 (HARRAY 60))
(SETQ SWSUF (HARRAY 60))
[MAPC SUF-PARTS (FUNCTION (LAMBDA (FACET)
(PUTHASH FACET (PACK (LIST FACET 1))
SUF1)
(PUTHASH FACET (PACK (LIST FACET 2))
SUF2)
(PUTHASH (GETHASH FACET SUF2)
(GETHASH FACET SUF1)
SWSUF)
(PUTHASH (GETHASH FACET SUF1)
(GETHASH FACET SUF2)
SWSUF]
(CPRIN1 0 CRLF "INITIALIZATION COMPLETED. TO START AM, TYPE (START)" CRLF])
(OSET
[NLAMBDA X
(CONS (QUOTE OSET)
X])
(PAIR
[NLAMBDA X
(CONS (QUOTE PAIR)
X])
(STRUC
[NLAMBDA X
(CONS (QUOTE STRUC)
X])
(VECTOR
[NLAMBDA X
(CONS (QUOTE VECTOR)
X])
)
(RPAQQ CONCEPTS
(NONMULT-STRUC MULT-STRUC UNORD-STRUC-EXS UNORD-STRUC ORD-STRUC SET-STRUC-DIFF SET-STRUC-INTERSECT
STRUCTURE-INTERSECT STRUCTURE-DIFF BAG-STRUC-INSERT LIST-STRUC-INSERT OSET-STRUC-INSERT
SET-STRUC-INSERT OBJ-EQUAL ACTIVE ANYB ANYB-ANAS ANYB-ANYP ANYB-CHECK ANYB-CHECK1 ANYB-CHECK2
ANYB-D-R ANYB-DEFN ANYB-DEFN-NOT ANYB-EXS ANYB-EXS-BDY ANYB-EXS-NOT ANYB-EXS-NOT-BDY
ANYB-FILLIN ANYB-FILLIN1 ANYB-FILLIN2 ANYB-GENL ANYB-INIT ANYB-INT ANYB-INT-NOT ANYB-INTU
ANYB-INV ANYB-OPS ANYB-RESTRUC ANYB-SPEC ANYB-SUGG ANYB-UP ANYB-VIEW ANYB-WORTH BAG-STRUC
CONSTRUCTIVE FINAL FIRST LIST-STRUC OBJ-EQUAL OBJECT OPERATION ORD-PAIR OSET-STRUC PREDICATE
REAR RELATION SET-STRUC SET-STRUC-DELETE STRUCTURE STRUCTURE-DELETE STRUCTURE-EQUAL
STRUCTURE-EXS STRUCTURE-EXS-BDY STRUCTURE-INSERT STRUCTURE-MEMB BAG-STRUC-DELETE
LIST-STRUC-DELETE OSET-STRUC-DELETE))
(RPAQQ NONMULT-STRUC (FROM-FILE CON4))
(RPAQQ MULT-STRUC (FROM-FILE CON4))
(RPAQQ UNORD-STRUC-EXS (FROM-FILE CON4))
(RPAQQ UNORD-STRUC (FROM-FILE CON4))
(RPAQQ ORD-STRUC (FROM-FILE CON4))
(RPAQQ SET-STRUC-DIFF (FROM-FILE CON4))
(RPAQQ SET-STRUC-INTERSECT (FROM-FILE CON4))
(RPAQQ STRUCTURE-INTERSECT (FROM-FILE CON4))
(RPAQQ STRUCTURE-DIFF (FROM-FILE CON4))
(RPAQQ BAG-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ LIST-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ OSET-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ SET-STRUC-INSERT (FROM-FILE CON4))
(RPAQQ OBJ-EQUAL (FROM-FILE CON4))
(RPAQQ ACTIVE (FROM-FILE CON4))
(RPAQQ ANYB (FROM-FILE CON4))
(RPAQQ ANYB-ANAS (FROM-FILE CON4))
(RPAQQ ANYB-ANYP (FROM-FILE CON4))
(RPAQQ ANYB-CHECK (FROM-FILE CON4))
(RPAQQ ANYB-CHECK1 (FROM-FILE CON4))
(RPAQQ ANYB-CHECK2 (FROM-FILE CON4))
(RPAQQ ANYB-D-R (FROM-FILE CON4))
(RPAQQ ANYB-DEFN (FROM-FILE CON4))
(RPAQQ ANYB-DEFN-NOT (FROM-FILE CON4))
(RPAQQ ANYB-EXS (FROM-FILE CON4))
(RPAQQ ANYB-EXS-BDY (FROM-FILE CON4))
(RPAQQ ANYB-EXS-NOT (FROM-FILE CON4))
(RPAQQ ANYB-EXS-NOT-BDY (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN1 (FROM-FILE CON4))
(RPAQQ ANYB-FILLIN2 (FROM-FILE CON4))
(RPAQQ ANYB-GENL (FROM-FILE CON4))
(RPAQQ ANYB-INIT (FROM-FILE CON4))
(RPAQQ ANYB-INT (FROM-FILE CON4))
(RPAQQ ANYB-INT-NOT (FROM-FILE CON4))
(RPAQQ ANYB-INTU (FROM-FILE CON4))
(RPAQQ ANYB-INV (FOUT CON4))
(RPAQQ ANYB-OPS (FROM-FILE CON4))
(RPAQQ ANYB-RESTRUC (FROM-FILE CON4))
(RPAQQ ANYB-SPEC (FROM-FILE CON4))
(RPAQQ ANYB-SUGG (FROM-FILE CON4))
(RPAQQ ANYB-UP (FROM-FILE CON4))
(RPAQQ ANYB-VIEW (FROM-FILE CON4))
(RPAQQ ANYB-WORTH (FROM-FILE CON4))
(RPAQQ BAG-STRUC (FROM-FILE CON4))
(RPAQQ CONSTRUCTIVE (FROM-FILE CON4))
(RPAQQ FINAL (FROM-FILE CON4))
(RPAQQ FIRST (FROM-FILE CON4))
(RPAQQ LIST-STRUC (FROM-FILE CON4))
(RPAQQ OBJ-EQUAL (FROM-FILE CON4))
(RPAQQ OBJECT (FROM-FILE CON4))
(RPAQQ OPERATION (FROM-FILE CON4))
(RPAQQ ORD-PAIR (FROM-FILE CON4))
(RPAQQ OSET-STRUC (FROM-FILE CON4))
(RPAQQ PREDICATE (FROM-FILE CON4))
(RPAQQ REAR (FROM-FILE CON4))
(RPAQQ RELATION (FROM-FILE CON4))
(RPAQQ SET-STRUC (FROM-FILE CON4))
[RPAQQ SET-STRUC-DELETE (FROM-FILE GENL (STRUCTURE-DELETE)
WORTH
(0)
ALGS
[ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE SET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP
(SET-STRUC-OPS)
INV
(TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2]
(RPAQQ STRUCTURE (FROM-FILE CON4))
(RPAQQ STRUCTURE-DELETE (FROM-FILE CON4))
(RPAQQ STRUCTURE-EQUAL (FROM-FILE CON4))
(RPAQQ STRUCTURE-EXS (FROM-FILE CON4))
(RPAQQ STRUCTURE-EXS-BDY (FROM-FILE CON4))
(RPAQQ STRUCTURE-INSERT (FROM-FILE CON4))
(RPAQQ STRUCTURE-MEMB (FROM-FILE CON4))
(RPAQQ BAG-STRUC-DELETE (FROM-FILE CON4))
(RPAQQ LIST-STRUC-DELETE (FROM-FILE CON4))
[RPAQQ OSET-STRUC-DELETE (FROM-FILE GENL (STRUCTURE-DELETE)
WORTH
(0)
ALGS
[ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE SET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP
(SET-STRUC-OPS)
INV
(TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2]
(RPAQQ FACETS
(ALGS ANAS CHECK CHECK1 CHECK2 D-R DEFN DEFN-NOT EXS EXS-BDY EXS-NOT EXS-NOT-BDY FILLIN FILLIN1 FILLIN2 GENL
INIT INT INT-NOT INTU INV OPS RESTRUC SPEC SUGG UP VIEW WORTH))
(RPAQQ ALGS NIL)
(RPAQQ ANAS NIL)
(RPAQQ CHECK NIL)
(RPAQQ CHECK1 NIL)
(RPAQQ CHECK2 NIL)
(RPAQQ D-R NIL)
(RPAQQ DEFN NIL)
(RPAQQ DEFN-NOT NIL)
(RPAQQ EXS NIL)
(RPAQQ EXS-BDY NIL)
(RPAQQ EXS-NOT NIL)
(RPAQQ EXS-NOT-BDY NIL)
(RPAQQ FILLIN NIL)
(RPAQQ FILLIN1 NIL)
(RPAQQ FILLIN2 NIL)
(RPAQQ GENL NIL)
(RPAQQ INIT NIL)
(RPAQQ INT NIL)
(RPAQQ INT-NOT NIL)
(RPAQQ INTU INTU)
(RPAQQ INV NIL)
(RPAQQ OPS NIL)
(RPAQQ RESTRUC NIL)
(RPAQQ SPEC NIL)
(RPAQQ SUGG NIL)
(RPAQQ UP NIL)
(RPAQQ VIEW NIL)
(RPAQQ WORTH NIL)
(DEFINEQ
(ALGS
[NLAMBDA (B BA1 BA2 BA3 BA4)
(POR (QUOTE ALGS)
B BA1 BA2 BA3 BA4])
(ANAS
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE ANAS)
B BA1 BA2 BA3])
(CHECK
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 PP P)
(AND (SETQ C1 (GETP (QUOTE CHECK)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(SETQQ PP CHECK)
(OR (AND BA1 (FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(SETQ GEXISTING (GETB B PP))
(PROGN [MAPC RS (FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE CHECK1)
BA1 BA2 BA3]
[MAPC (DREVERSE RS)
(FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE CHECK2)
BA1 BA2 BA3]
T])
(CHECK1
[NLAMBDA (B)
(PGET (QUOTE CHECK1)
B])
(CHECK2
[NLAMBDA (B)
(PGET (QUOTE CHECK2)
B])
(D-R
[NLAMBDA (B)
(PGET (QUOTE D-R)
B])
(DEFN
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(AND (SETQ C1 (GETP (QUOTE DEFN)
(QUOTE CENT)))
(SETQ RS (REVERSE (RIPPLE-SIMULT B C1)))
(GETB B (QUOTE DEFN))
(PROG NIL
L1 (OR (AND (APPLY* (QUOTE DEFN-NOT)
(CAR RS)
BA1 BA2 BA3)
(RETURN NIL))
(AND (SETQ ATMP (APPLYB (CAR RS)
(QUOTE DEFN)
BA1 BA2 BA3))
(RETURN ATMP))
(AND (SETQ RS (CDR RS))
(GO L1))
(RETURN NIL])
(DEFN-NOT
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 ATMP)
(AND (SETQ C1 (GETP (QUOTE DEFN-NOT)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(GETB B (QUOTE DEFN-NOT))
(SOME-EBP RS (QUOTE DEFN-NOT)
BA1 BA2 BA3])
(EXS
[NLAMBDA (B)
(PGET (QUOTE EXS)
B])
(EXS-BDY
[NLAMBDA (B)
(PGET (QUOTE EXS-BDY)
B])
(EXS-NOT
[NLAMBDA (B)
(PGET (QUOTE EXS-NOT)
B])
(EXS-NOT-BDY
[NLAMBDA (B)
(PGET (QUOTE EXS-NOT-BDY)
B])
(FILLIN
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1 PP)
(AND (SETQ C1 (GETP (QUOTE FILLIN)
(QUOTE CENT)))
(SETQ RS (RIPPLE-SIMULT B C1))
(SETQ PP (QUOTE FILLIN))
(OR (AND BA1 (FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(SETQ GEXISTING (INIT-PART B PP))
(NCONCB B PP (NCONC [MAPCONC RS (FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE FILLIN1)
BA1 BA2 BA3]
(MAPCONC (DREVERSE RS)
(FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE FILLIN2)
BA1 BA2 BA3])
(FILLIN1
[NLAMBDA (B)
(PGET (QUOTE FILLIN1)
B])
(FILLIN2
[NLAMBDA (B)
(PGET (QUOTE FILLIN2)
B])
(GENL
[NLAMBDA (B)
(PGET (QUOTE GENL)
B])
(INIT
[NLAMBDA (B)
(PGET (QUOTE INIT)
B])
(INT
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INT)
B BA1 BA2 BA3])
(INT-NOT
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INT-NOT)
B BA1 BA2 BA3])
(INTU
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INTU)
B BA1 BA2 BA3])
(INV
[NLAMBDA (B BA1 BA2 BA3 BA4)
(PXEQ (QUOTE INV)
B BA1 BA2 BA3 BA4])
(OPS
[NLAMBDA (B)
(PGET (QUOTE OPS)
B])
(RESTRUC
[NLAMBDA (B)
(PGET (QUOTE RESTRUC)
B])
(SPEC
[NLAMBDA (B)
(PGET (QUOTE SPEC)
B])
(SUGG
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE SUGG)
B BA1 BA2 BA3])
(UP
[NLAMBDA (B)
(PGET (QUOTE UP)
B])
(VIEW
[NLAMBDA (B BA1 BA2 BA3 BA4 RS C1)
(SETQ C1 (GETP (QUOTE VIEW)
(QUOTE CENT)))
(AND (SETQ RS (REVERSE (RIPPLE-SIMULT B C1)))
(GETB B (QUOTE VIEW))
(SOME-EBP RS (QUOTE VIEW)
BA1 BA2 BA3 BA4])
(WORTH
[NLAMBDA (B)
(PGET (QUOTE WORTH)
B])
)
(RPAQQ AUX-FACETS (FILLIN1 FILLIN2 CHECK1 CHECK2))
(RPAQQ FILLIN1 NIL)
(RPAQQ FILLIN2 NIL)
(RPAQQ CHECK1 NIL)
(RPAQQ CHECK2 NIL)
(RPAQQ SUF-PARTS (FILLIN CHECK))
(RPAQQ STRATEGY-PARTS (FILLIN CHECK))
(RPAQQ XEQ-PARTS (DEFN-NOT ALGS ANAS CHECK CHECK1 CHECK2 FILLIN FILLIN1 FILLIN2 INT INT-NOT INTU INV SUGG VIEW
RESTRUC DEFN))
(RPAQQ XS-PARTS (DEFN-NOT VIEW ALGS ANAS CHECK1 CHECK2 DEFN FILLIN1 FILLIN2 INT INT-NOT INTU INV SUGG RESTRUC))
(RPAQQ OR-PARTS (DEFN DEFN-NOT ALGS VIEW))
(PUTPROPS NONMULT-STRUC GENL (STRUCTURE)
SPEC (OSET-STRUC SET-STRUC)
WORTH (0))
(PUTPROPS MULT-STRUC GENL (STRUCTURE)
SPEC (LIST-STRUC BAG-STRUC)
WORTH (0))
(PUTPROPS UNORD-STRUC-EXS GENL (STRUCTURE-EXS)
WORTH (0)
CHECK1 [AND (GETHASH [SETQ GTEMP4 (PACK (LIST CS-B (QUOTE -INSERT]
HCON)
(SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(APPEND (GETB (QUOTE ANYB-EXS)
(QUOTE INIT))
(ANY1OF
[MAPCAR (GETB CS-B (QUOTE EXS))
(FUNCTION (LAMBDA
(Z)
(CONS (CAR Z)
(SORT (CDR Z)
(QUOTE SORD]
(MAPCAR (GETB CS-B (QUOTE EXS))
(FUNCTION
(LAMBDA
(Z X)
(SETQ X (LIST (CAR Z)))
[MAPC (REVERSE (CDR Z))
(FUNCTION
(LAMBDA
(ZZ)
(APPLYB GTEMP4
(QUOTE ALGS)
ZZ X]
X])
(PUTPROPS UNORD-STRUC GENL (STRUCTURE)
SPEC (BAG-STRUC SET-STRUC)
WORTH (0))
(PUTPROPS ORD-STRUC GENL (STRUCTURE)
SPEC (LIST-STRUC OSET-STRUC)
WORTH (0))
(PUTPROPS SET-STRUC-DIFF GENL (STRUCTURE-DIFF)
WORTH (0)
ALGS (ANY1OF [TYPE NONRECURSIVE (SUBSET BA1 (FUNCTION (LAMBDA (Z)
(NOT (APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA2]
(TYPE RECURSIVE (PROGN [COND ((SETQ BA4 (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL BA2))
(SETQ BA1 (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA4 BA1))
(SETQ BA1 (APPLYB (QUOTE SET-INTERSECT'ALGS)
BA1 BA2))
(AND (NOT (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA4 BA2))
(APPLYB (QUOTE SET-STRUC-INSERT)
BA4 BA1]
BA1)))
UP (SET-STRUC-OPS))
(PUTPROPS SET-STRUC-INTERSECT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE QUICK OPAQUE (INTERSECTION BA1 BA2))
[TYPE NONRECURSIVE (ANY1OF [SUBSET BA1 (FUNCTION (LAMBDA
(Z)
(APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA2]
(SUBSET BA2 (FUNCTION (LAMBDA
(Z)
(APPLYB (QUOTE
STRUCTURE-MEMB)
(QUOTE ALGS)
Z BA1]
(TYPE RECURSIVE (PROGN [COND ((SETQ BA4 (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL BA2))
(SETQ BA1 (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA4 BA1))
(SETQ BA1 (APPLYB (QUOTE SET-STRUC-INTERSECT)
(QUOTE ALGS)
BA1 BA2))
(AND (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA4 BA2)
(APPLYB (QUOTE SET-STRUC-INSERT)
BA4 BA1]
BA1)))
UP (SET-STRUC-OPS))
(PUTPROPS STRUCTURE-INTERSECT GENL (OPERATION)
WORTH (0)
UP (STRUCTURE-OPS)
ALGS [ANY1OF (TYPE NONRECURSIVE CASES BRANCH
(PROGN [SETQ GTEMP3
(CAR (SOME (PROGN (SETQ GTEMP2 (GETB (QUOTE STRUCTURE)
(QUOTE SPEC)))
(OR (AND BA3 (FMEMB BA3 GTEMP2)
(CONS BA3 (REMOVE BA3 GTEMP2)
))
GTEMP2))
(FUNCTION
(LAMBDA (S)
(OR (FMEMB S (UP BA2))
(FMEMB BA2
(APPLY* (QUOTE EXS)
S))
(APPLYB S (QUOTE DEFN)
BA2]
(OR (AND BA3 (NEQ BA3 GTEMP3)
BA2
(SETQ GTEMP1 (APPLY* (QUOTE VIEW)
GTEMP3 BA3 BA2))
(SETQ GTEMP3 BA3)
(SETQ BA2 GTEMP1))
(AND (NOT GTEMP3)
BA3
(SETQ GTEMP3 BA3)))
(APPLYB (PACK (LIST GTEMP3 (QUOTE INTERSECT)))
(QUOTE ALGS)
BA1 BA2])
(PUTPROPS STRUCTURE-DIFF GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK (AND (LISTP BA1)
(LISTP BA2)
(EQ (CAR BA1)
(CAR BA2))
(SUBSET BA1
(FUNCTION
(LAMBDA
(Z)
(PROG1 (EQUAL Z (CAR BA2))
(SETQ BA2 (CDR BA2]
UP (STRUCTURE-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DIFF)
(QUOTE ALGS)
BA2 BA1 BA3)))
(PUTPROPS BAG-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE BAG-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE BAG-STRUC)
(QUOTE EXS]
(OR BA1 (SETQ BA1 (RAND-THING)))
(ATTACH (CAR BA2)
(MERGE (LIST BA1)
(CDR BA2)
(QUOTE SORD]
UP (BAG-STRUC-OPS))
(PUTPROPS LIST-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 (SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE LIST-STRUC)
(QUOTE EXS]
(OR BA1 (SETQ BA1 (RAND-THING)))
(ATTACH (CAR BA2)
(FRPLACA BA2 BA1]
UP (LIST-STRUC-OPS))
(PUTPROPS OSET-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE OSET-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE OSET-STRUC)
(QUOTE EXS]
(OR BA1 (NOT (FMEMB (SETQ BA1 (RAND-THING))
BA2))
(SETQ BA1 (COPY BA2)))
(OR (FMEMB BA1 (CDR BA2))
(ATTACH (CAR BA2)
(FRPLACA BA2 BA1)))
BA2)))
UP (OSET-STRUC-OPS))
(PUTPROPS SET-STRUC-INSERT GENL (STRUCTURE-INSERT)
WORTH (0)
ALGS (ANY1OF (TYPE NONRECURSIVE OPAQUE QUICK
(AND [OR BA2 [SETQ BA2 (LIST (CAAR (LAST (GETB (QUOTE SET-STRUC)
(QUOTE EXS]
(BOOST (LIST (QUOTE FILLIN)
(QUOTE SET-STRUC)
(QUOTE EXS]
(OR BA1 (NOT (FMEMB (SETQ BA1 (RAND-THING))
BA2))
(SETQ BA1 (COPY BA2)))
[OR (FMEMB BA1 (CDR BA2))
(FRPLACD BA2 (MERGE (LIST BA1)
(CDR BA2)
(QUOTE SORD]
BA2)))
UP (SET-STRUC-OPS))
(PUTPROPS OBJ-EQUAL GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE (EQUAL BA1 BA2))
(TYPE RECURSIVE (COND ((AND (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
(EQ (CAR BA1)
(CAR BA2)))
((OR (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
NIL)
(T (AND (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2))
(APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA2]
UP (STRUCTURE-OPS)
SPEC (SET-STRUC-EQUAL BAG-STRUC-EQUAL OSET-STRUC-EQUAL LIST-STRUC-EQUAL))
(PUTPROPS ACTIVE GENL (ANYB)
SPEC (RELATION PREDICATE OPERATION)
WORTH (0)
DEFN (ANY-OF NIL))
(PUTPROPS ANYB GENL NIL
INT (IPLUS 0)
WORTH (0)
VIEW (ANY-OF [PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
[AND (FMEMB (QUOTE STRUCTURE)
GTEMP5)
(LIST (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
(COPY BA2)
NIL
(CAR (INTERSECTION GTEMP5 (GETB (QUOTE STRUCTURE)
(QUOTE SPEC]
(AND (FMEMB (QUOTE ORD-PAIR)
GTEMP5)
(LIST (QUOTE PAIR)
BA2 BA2))))
(PUTPROPS ANYB-ANAS GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-ANYP GENL (ANYB)
FILLIN1 (APPEND (APPLY (QUOTE UNION)
(APPLYB CS-B (QUOTE ANAS)
CS-P)))
CHECK2 [AND (PROG1 T (ADD-CANDS (LIST (LIST (RMUL CS-INT 1 2)
(QUOTE RESTRUC)
CS-B CS-P]
WORTH (0))
(PUTPROPS ANYB-CHECK GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-CHECK1 GENL (ANYB-ANYP))
(PUTPROPS ANYB-CHECK2 GENL (ANYB-ANYP))
(PUTPROPS ANYB-D-R GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-DEFN GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-DEFN-NOT GENL (ANYB-ANYP)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-EXS GENL (ANYB-ANYP)
FILLIN1 (APPEND (INSTAN-S (GETB CS-B (QUOTE SPEC))
BA1)
(INSTAN-D (GETB CS-B (QUOTE DEFN))
BA1)
(INSTAN-I (GETB CS-B (QUOTE INTU))
BA1))
FILLIN2 [APPEND (PROG1 NIL (SORT (GETB CS-B (QUOTE EXS))
(QUOTE COUNT))
[AND ORIG-EMP GEXISTING
(MAPC (APPLY* (QUOTE OPS)
CS-B)
(FUNCTION (LAMBDA (B1)
(OR (GETB B1 (QUOTE EXS))
(INCRB B1 (QUOTE EXS)
(NCONC1 (COPY (COMMENT EXS OF YOUR
DOMAIN ARE
ON))
CS-B]
[ADD-CANDS (LIST (LIST (RMUL CS-INT 3 4)
(QUOTE CHECK)
CS-B
(QUOTE EXS]
(COND ([SETQ GTEMP9 (INT-ENUF (GETB CS-B (QUOTE INT]
(SETQ ILEV (AVG2 CS-INT 500))
[CREATEB (SETQ NEWB (PACK (LIST (QUOTE INTERESTING-)
CS-B]
(SETB NEWB (QUOTE GENL)
(LIST CS-B))
(SETB NEWB (QUOTE DEFN)
(NCONC [LIST (QUOTE AND)
(LIST (QUOTE APPLYB)
(KWOTE CS-B)
(KWOTE (QUOTE DEFN]
GTEMP9))
(SETB NEWB (QUOTE WORTH)
(PROGN [SETQ GTEMP4 (COPY (GETB CS-B (QUOTE WORTH]
(SET-NTH GTEMP4 1 NEW-ILEV)
[SET-NTH GTEMP4 11
(LIST (QUOTE COND)
(LIST (LIST (QUOTE GETB)
NEWB
(KWOTE (QUOTE EXS)))
(ADD1 (CAR (FNTH GTEMP4 11]
GTEMP4))
(ADD-CANDS (LIST (LIST (SUB1 CS-INT)
(QUOTE FILLIN)
NEWB
(QUOTE EXS]
CHECK1 [AND (PROG1 T (MAPC GEXISTING (FUNCTION (LAMBDA (X1)
(COND ((AND (GETB CS-B (QUOTE DEFN))
(NOT (APPLYB CS-B (QUOTE DEFN)
X1)))
(GTRANSFER X1 (QUOTE NOT-BDY)))
((AND (GETB CS-B (QUOTE INTU))
(NOT (APPLYB CS-B (QUOTE INTU)
X1)))
(GTRANSFER X1 (QUOTE BDY]
SUGG [APPEND [MAPCONC PAST (FUNCTION (LAMBDA (PE)
(COND ((EQ (P-P PE)
(QUOTE EXS))
(LIST (LIST (COND ((NUMBERP (PINT PE))
(RMUL (PINT PE)
1 2))
(T 250))
(QUOTE RE-JUDGE)
(P-B PE)
(QUOTE EXS]
(MAPCONC CONCEPTS (FUNCTION (LAMBDA
(C)
(AND (NULL (GETB C (QUOTE EXS)))
(LIST (LIST [FIX (DOTPROD (LIST .7 .1 .1 .1)
(GETB C (QUOTE WORTH]
(QUOTE FILLIN)
C
(QUOTE EXS]
WORTH (0)
INIT (ANY-OF NIL)
CHECK2 [AND (SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(APPEND (GETB (QUOTE ANYB-EXS)
(QUOTE INIT))
(APPLYB (QUOTE SET-STRUC-DIFF)
(QUOTE ALGS)
(APPLYB (QUOTE SET-STRUC-INTERSECT)
(QUOTE ALGS)
(GETB CS-B (QUOTE EXS))
(GETB CS-B (QUOTE EXS)))
(GETB CS-B (QUOTE EXS-BDY])
(PUTPROPS ANYB-EXS-BDY GENL (ANYB-ANYP)
CHECK1 [AND (PROG1 T (MAPC GEXISTING (FUNCTION (LAMBDA (X1)
(COND
[(FMEMB X1 (LIST NIL (QUOTE ANY1OF)
(QUOTE ANY-OF]
((AND (GETB CS-B (QUOTE DEFN))
(NOT (APPLYB CS-B (QUOTE DEFN)
X1)))
(GTRANSFER X1 (QUOTE NOT-BDY)))
((AND (GETB CS-B (QUOTE INTU))
(NOT (APPLYB CS-B (QUOTE INTU)
X1)))
(GTRANSFER X1 (QUOTE BDY]
SUGG [APPEND (MAPCONC CONCEPTS (FUNCTION
(LAMBDA (C)
(AND (NULL (GETB C (QUOTE EXS-BDY)))
(LIST (LIST [FIX (DOTPROD (LIST .3 .1 .1)
(GETB C (QUOTE WORTH]
(QUOTE FILLIN)
C
(QUOTE EXS-BDY]
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-EXS-NOT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-EXS-NOT-BDY GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-FILLIN GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-FILLIN1 GENL (ANYB-ANYP))
(PUTPROPS ANYB-FILLIN2 GENL (ANYB-ANYP))
(PUTPROPS ANYB-GENL GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-INIT GENL (ANYB-ANYP))
(PUTPROPS ANYB-INT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-INT-NOT GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-INTU GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-INV GENL (ANYB-ANYP)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-OPS GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-RESTRUC GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-SPEC GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-SUGG GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-UP GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-VIEW GENL (ANYB-ANYP)
INIT (ANY-OF NIL))
(PUTPROPS ANYB-WORTH GENL (ANYB-ANYP)
WORTH (0)
INIT (ANY-OF NIL))
(PUTPROPS BAG-STRUC GENL (UNORD-STRUC MULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('BAG $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE BAG]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE BAG-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE BAG)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE BAG)
(APPEND (SETQ RB1 (RAND-SUBSET USERNAMES))
(RAND-SUBSET RB1)))
(CONS (QUOTE BAG)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE BAG]
OPS (BAG-STRUC-INSERT))
(PUTPROPS CONSTRUCTIVE GENL (PREDICATE)
WORTH (0)
DEFN [ANY1OF (TYPE QUASIRECURSIVE (OR (FMEMB BA1 CONSTRUCTIVE-OPS)
(RIPPLE-UNTIL BA1 (QUOTE GENL)
(LIST (QUOTE FMEMB)
(QUOTE B)
(QUOTE CONSTRUCTIVE-OPS])
(PUTPROPS FINAL WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND ((AND BA2 (CDR BA1))
(FRPLACA (LAST BA1)
BA2))
(T (CAR (LAST (CDR BA1]
UP (OPERATION)
DEFN [ANY-OF (TYPE QUASIRECURSIVE (EQUAL BA2 (APPLYB (QUOTE FINAL)
(QUOTE ALGS)
BA1])
(PUTPROPS FIRST WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND (BA2 (FSET-NTH BA1 2 BA2))
(T (CADR BA1]
UP (OPERATION)
DEFN [ANY-OF (TYPE QUASIRECURSIVE (EQUAL BA2 (APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA1])
(PUTPROPS LIST-STRUC GENL (ORD-STRUC MULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('VECTOR $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE VECTOR]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE LIST-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE VECTOR)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE VECTOR)
(APPEND (SETQ RB1 (RAND-SUBSET USERNAMES))
(RAND-SUBSET RB1)))
(CONS (QUOTE VECTOR)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
OPS (LIST-STRUC-INSERT FIRST REAR FINAL)
EXS (ANY-OF NIL (VECTOR (VECTOR))
(VECTOR (CLASS DOUG))
(VECTOR DOUG ED BRUCE)
(VECTOR DOUG)
(VECTOR ED)
(VECTOR DOUG ED)
(VECTOR ED DOUG)
(VECTOR DOUG DOUG)
(VECTOR ED ED)
(VECTOR DOUG ED ED)
(VECTOR DOUG ED DOUG)
(VECTOR DOUG DOUG ED)
(VECTOR ED ED ED)
(VECTOR DOUG DOUG DOUG)
(VECTOR ED ED DOUG)
(VECTOR ED DOUG ED)
(VECTOR ED DOUG DOUG))
EXS-BDY (ANY-OF NIL (VECTOR))
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE VECTOR]
VIEW (ANY-OF NIL))
(PUTPROPS OBJ-EQUAL GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE OPAQUE (EQUAL BA1 BA2))
(TYPE RECURSIVE (COND ((AND (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
(EQ (CAR BA1)
(CAR BA2)))
((OR (NLISTP (CDR BA1))
(NLISTP (CDR BA2)))
NIL)
(T (AND (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2))
(APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA2]
UP (STRUCTURE-OPS)
SPEC (SET-STRUC-EQUAL BAG-STRUC-EQUAL OSET-STRUC-EQUAL LIST-STRUC-EQUAL))
(PUTPROPS OBJECT GENL (ANYB)
SPEC (STRUCTURE ORD-PAIR)
WORTH (0))
(PUTPROPS OPERATION GENL (ACTIVE)
WORTH (0))
(PUTPROPS ORD-PAIR GENL (OBJECT)
INT (IPLUS 0)
OPS (REV-PAIR FIRST FINAL)
WORTH (75 200 700 500 400 990 900 1000 800 800 (COND ((GETB INTERESTING-ORD-PAIR (QUOTE EXS))
801)))
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('PAIR & &]
VIEW [ANY-OF [PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
(AND (FMEMB (QUOTE STRUCTURE)
GTEMP5)
(LIST (CAR (INTERSECTION (GETB (QUOTE STRUCTURE)
(QUOTE SPEC))
GTEMP5))
(APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2)
(APPLYB (QUOTE FINAL)
(QUOTE ALGS)
BA2]
INTU (ANY1OF (LIST (QUOTE PAIR)
(RAND-MEMB USERNAMES)
(RAND-MEMB USERNAMES))
(LIST (QUOTE PAIR)
(RAND-THING)
(RAND-THING))
(LIST (QUOTE PAIR)
(SETQ RB1 (RAND-THING))
RB1))
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NLISTP BA1))
(TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE PAIR])
(PUTPROPS OSET-STRUC GENL (ORD-STRUC NONMULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('OSET $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE OSET]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE OSET-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE OSET)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE OSET)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
OPS (OSET-STRUC-INSERT FIRST REAR FINAL)
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE OSET])
(PUTPROPS PREDICATE GENL (ACTIVE)
WORTH (0))
(PUTPROPS REAR WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE (COND [BA2 (CONS (CAR BA1)
(CONS (CADR BA1)
(CDR BA2]
(T (CONS (CAR BA1)
(CDDR BA1]
UP (STRUCTURE-OPS)
DEFN (ANY-OF (TYPE QUASIRECURSIVE (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE REAR)
(QUOTE ALGS)
BA1)
BA2))))
(PUTPROPS RELATION GENL (ACTIVE)
WORTH (0))
(PUTPROPS SET-STRUC GENL (UNORD-STRUC NONMULT-STRUC)
WORTH (800 800 700 500 400 990 900 1000 800 800 1000)
DEFN [ANY1OF (TYPE NONRECURSIVE (MATCH BA1 WITH ('CLASS $)))
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE CLASS]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE SET-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [ANY1OF (CONS (QUOTE CLASS)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE CLASS)
(RECTANGLE (RAND 0 7)
(RAND 0 7)
(RAND 0 7)
(RAND 0 7]
OPS (SET-STRUC-INSERT)
DEFN-NOT [ANY-OF (TYPE NONRECURSIVE (NEQ (CAR BA1)
(QUOTE CLASS]
VIEW (ANY-OF NIL))
(PUTPROPS SET-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE SET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP (SET-STRUC-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE SET-STRUC))))
(PUTPROPS STRUCTURE GENL (OBJECT)
INT [IPLUS 0
(COND
(T 0 (MAX (CDR BA1)
(FUNCTION
(LAMBDA
(M1)
(DOTPROD (.9 .1)
(COND
((GETB M1 (QUOTE WORTH)))
((LIST (FAN [COND ((GETB M1 (QUOTE GENL)))
[(SUBSET CONCEPTS
(FUNCTION
(LAMBDA
(KC)
(MEMBER M1
(GETB KC
(QUOTE EXS]
((LIST (QUOTE ANYB]
(QUOTE INT)
M1]
SPEC (LIST-STRUC BAG-STRUC OSET-STRUC SET-STRUC)
OPS (STRUCTURE-INSERT STRUCTURE-MEMB STRUCTURE-DELETE STRUCTURE-EQUAL)
WORTH (0)
DEFN2 [ANY1OF (TYPE BRANCH (CAR (SOME (GETBQ STRUCTURE SPEC)
(FUNCTION (LAMBDA (X)
(APPLYB X (QUOTE DEFN)
(COPY BA1)
BA2]
VIEW [ANY-OF
[PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL]
(AND
(FMEMB (QUOTE STRUCTURE)
GTEMP5)
(APPEND (PROGN [SETQ
GTEMP3
(LIST (CAAR (LAST (OR (GETB (SETQ GTEMP4
(CAR (INTERSECTION
(GETB (QUOTE STRUCTURE)
(QUOTE SPEC))
GTEMP5)))
(QUOTE EXS))
GEXISTING]
(OR GTEMP4 (SETQ GTEMP4 CS-B))
[SETQ GTEMP4 (PACK (LIST GTEMP4 (QUOTE -INSERT]
(OR (NOT (GETHASH GTEMP4 HCON))
[MAPC (REVERSE (CDR BA2))
(FUNCTION (LAMBDA (Z)
(SETQ GTEMP3 (APPLYB GTEMP4 (QUOTE ALGS)
Z GTEMP3]
(LIST GTEMP3]
DEFN (ANY-OF NIL)
DEFN-NOT (ANY-OF (NLISTP BA1)))
(PUTPROPS STRUCTURE-DELETE GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF [TYPE NONRECURSIVE (AND (SETQ GTEMP7 (FMEMB BA1 (CDR BA2)))
(COND ((CDR GTEMP7)
(RPLACA GTEMP7 (APPEND (CADR GTEMP7)))
(RPLACD GTEMP7 (CDDR GTEMP7)))
((RPLACD BA2 (DREMOVE BA1 (CDR BA2]
(TYPE RECURSIVE (COND ((NULL (SETQ BA3 (APPLYB (QUOTE FIRST)
(QUOTE ALGS)
BA2)))
BA2)
(T (RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE BAG-STRUC-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (STRUCTURE-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (PROGN (ARG-SUBST (QUOTE BA1)
(RAND-MEMB GEXISTING)
(QUOTE BA2)
(RAND-THING))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
(OR (AND (LISTP BA1)
(EQ (CAR BA1)
(QUOTE APPLYB))
(EVAL (SUBST (QUOTE INV)
(QUOTE ALGS)
BA1)))
BA1)
(OR (AND (LISTP BA2)
(EQ (CAR BA2)
(QUOTE APPLYB))
(EVAL (SUBST (QUOTE INV)
(QUOTE ALGS)
BA2)))
BA2)
BA3))))
(PUTPROPS STRUCTURE-EQUAL GENL (OBJ-EQUAL)
WORTH (0)
UP (STRUCTURE-OPS))
(PUTPROPS STRUCTURE-EXS GENL [ANYB-EXS (OR-RUN: (LIST (RIPPLE1 (QUOTE STRUCTURE)
(QUOTE EXS)
(QUOTE GENL]
FILLIN2 [APPEND (MAPCONC (REMOVE CS-B (KINDS-OF (QUOTE STRUCTURE)))
(FUNCTION (LAMBDA (S)
(MAPCONC (APPLY* (QUOTE EXS)
S)
(FUNCTION (LAMBDA (X1)
(APPLY* (QUOTE VIEW)
S CS-B X1]
WORTH (0))
(PUTPROPS STRUCTURE-EXS-BDY GENL [ANYB-EXS-BDY (OR-RUN: (LIST (RIPPLE1 (QUOTE STRUCTURE)
(QUOTE EXS-BDY)
(QUOTE GENL]
FILLIN2 [APPEND [MAPCONC (REMOVE CS-B (KINDS-OF (QUOTE STRUCTURE)))
(FUNCTION (LAMBDA (S)
(MAPCONC (APPLY* (QUOTE EXS-BDY)
S)
(FUNCTION (LAMBDA
(X1)
(APPLY* (QUOTE VIEW)
S CS-B X1]
(PROG1 NIL [ADD-CANDS (LIST (CONS (AVG2 DO-THRESH CS-INT)
(SETQ GTEMP11 (LIST (QUOTE CHECK)
CS-B
(QUOTE EXS]
(MAPC PAST (FUNCTION (LAMBDA (Z)
(AND (EQUAL (CAR Z)
GTEMP11)
(ATTACH (QUOTE INCONCLUSIVELY)
(CAR Z]
WORTH (0)
CHECK2 [AND (SETQ
GEXISTING
(SETB CS-B (QUOTE EXS-BDY)
(APPEND (GETB (QUOTE ANYB-EXS-BDY)
(QUOTE INIT))
(MAPCON (GETB CS-B (QUOTE EXS-BDY))
(FUNCTION
(LAMBDA
(X)
(OR (AND (NOT (SOME (COPY (CDR X))
(QUOTE SEQX)))
(LIST (CAR X)))
(CPRIN1 8 " IN CHECKING, I FIND THAT "
(CAR X)
" DOESN'T BELONG AS AN EXAMPLE OF "
CS-B CRLF])
(PUTPROPS STRUCTURE-INSERT GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE NONRECURSIVE CASES BRANCH
(PROGN [SETQ GTEMP3
(CAR (SOME (PROGN (SETQ GTEMP2 (GETB (QUOTE STRUCTURE)
(QUOTE SPEC)))
(OR (AND BA3 (FMEMB BA3 GTEMP2)
(CONS BA3 (REMOVE BA3 GTEMP2)))
GTEMP2))
(FUNCTION (LAMBDA
(S)
(OR (FMEMB S (UP BA2))
(FMEMB BA2 (APPLY*
(QUOTE EXS)
S))
(APPLYB S (QUOTE DEFN)
BA2]
(OR (AND BA3 (NEQ BA3 GTEMP3)
BA2
(SETQ GTEMP1 (APPLY* (QUOTE VIEW)
GTEMP3 BA3 BA2))
(SETQ GTEMP3 BA3)
(SETQ BA2 GTEMP1))
(AND (NOT GTEMP3)
BA3
(SETQ GTEMP3 BA3)))
(APPLYB (PACK (LIST GTEMP3 (QUOTE -INSERT)))
(QUOTE ALGS)
BA1 BA2]
UP (STRUCTURE-OPS))
(PUTPROPS STRUCTURE-MEMB GENL (OPERATION)
WORTH (0)
ALGS [ANY1OF (TYPE QUICK OPAQUE (MEMBER BA1 BA2))
[TYPE RECURSIVE (AND BA1 (SETQ BA3 (RAND-MEMB (CDR BA2)))
(OR (APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA1
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
BA3 BA2]
[TYPE NONRECURSIVE CASES (COND ((AND BA1 (LISTP BA2))
(MEMBER BA1 (CDR BA2)))
((AND (NOT BA1)
(LISTP BA2))
(RAND-MEMB (CDR BA2)))
[(AND BA1 (ATOM BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA1
(RAND-MEMB (GETB BA2 (QUOTE EXS]
((AND BA1 (NOT BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA1
(RAND-MEMB (EXS STRUCTURE]
(TYPE ITERATIVE (AND BA1 (SOME (CDR BA2)
(FUNCTION (LAMBDA (Z)
(APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 Z]
UP (STRUCTURE-OPS)
INV [TYPE NONRECURSIVE CASES (COND ((AND BA1 (LISTP BA2))
(NOT (APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
BA1 BA2)))
((AND (NOT BA1)
(LISTP BA2))
(PROG (Z)
L1
(SETQ Z (RAND-THING))
(COND ((FMEMB Z BA2)
(GO L1)))
(RETURN Z)))
((AND BA1 (ATOM BA2))
(APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE INV)
BA1
(RAND-MEMB (OR (GETB BA2 (QUOTE EXS))
(APPLY* (QUOTE EXS)
BA2)
(EXS STRUCTURE])
(PUTPROPS BAG-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF [TYPE NONRECURSIVE (AND (SETQ GTEMP7 (FMEMB BA1 (CDR BA2)))
(COND ((CDR GTEMP7)
(RPLACA GTEMP7 (APPEND (CADR GTEMP7)))
(RPLACD GTEMP7 (CDDR GTEMP7)))
((RPLACD BA2 (DREMOVE BA1 (CDR BA2]
(TYPE RECURSIVE (COND ((NULL (CADR BA2))
BA2)
(T (SETQ BA3 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE BAG-STRUC-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE BAG-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (BAG-STRUC-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE BAG-STRUC))))
(PUTPROPS LIST-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CADR BA2))
BA2)
(T (SETQ BA3 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA3)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA3
(APPLYB (QUOTE LIST-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2]
UP (LIST-STRUC-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE LIST-STRUC))))
(PUTPROPS OSET-STRUC-DELETE GENL (STRUCTURE-DELETE)
WORTH (0)
ALGS [ANY1OF (TYPE RECURSIVE (COND ((NULL (CDR BA2))
BA2)
(T (SETQ BA4 (CADR BA2))
(RPLACD BA2 (CDDR BA2))
(SETQ BA2 (APPLYB (QUOTE OSET-STRUC-DELETE)
(QUOTE ALGS)
BA1 BA2))
(COND ((APPLYB (QUOTE OBJ-EQUAL)
(QUOTE ALGS)
BA1 BA4)
BA2)
(T (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
BA4 BA2]
UP (OSET-STRUC-OPS)
INV (TYPE NONRECURSIVE TRANSFORM (APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE INV)
BA1 BA2 (QUOTE OSET-STRUC))))
(PUTPROPS ALGS ARGS (BA1 BA2 BA3 BA4)
CENT (GENL))
(PUTPROPS ANAS ARGS (BA1 BA2 BA3))
(PUTPROPS CHECK ARGS (BA1 BA2 BA3)
CENT (GENL))
(PUTPROPS CHECK1 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS CHECK2 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS D-R ARGS (BA1 BA2 BA3))
(PUTPROPS DEFN ARGS (BA1 BA2 BA3)
CENT (SPEC))
(PUTPROPS DEFN-NOT ARGS (BA1 BA2 BA3 BA4)
CENT (GENL))
(PUTPROPS EXS ARGS (BA1 BA2 BA3)
CENT (SPEC))
(PUTPROPS EXS-BDY ARGS (BA1 BA2 BA3))
(PUTPROPS EXS-NOT ARGS (BA1 BA2 BA3))
(PUTPROPS EXS-NOT-BDY ARGS (BA1 BA2 BA3)
INIT NIL)
(PUTPROPS FILLIN ARGS (BA1 BA2 BA3)
CENT (GENL))
(PUTPROPS FILLIN1 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS FILLIN2 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS GENL ARGS (BA1 BA2 BA3)
CENT (GENL))
(PUTPROPS INIT ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS INT ARGS (BA1 BA2 BA3))
(PUTPROPS INT-NOT ARGS (BA1 BA2 BA3))
(PUTPROPS INTU ARGS (BA1 BA2 BA3))
(PUTPROPS INV ARGS (BA1 BA2 BA3 BA4)
CENT (GENL))
(PUTPROPS OPS ARGS (BA1 BA2 BA3)
CENT (GENL))
(PUTPROPS RESTRUC ARGS (BA1 BA2 BA3))
(PUTPROPS SPEC ARGS (BA1 BA2 BA3))
(PUTPROPS SUGG ARGS (BA1 BA2 BA3))
(PUTPROPS UP ARGS (BA1 BA2 BA3))
(PUTPROPS VIEW ARGS (BA1 BA2 BA3 BA4)
CENT (GENL))
(PUTPROPS WORTH ARGS (BA1 BA2 BA3))
(PUTPROPS FILLIN1 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS FILLIN2 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS CHECK1 ARGS (BA1 BA2 BA3 BA4))
(PUTPROPS CHECK2 ARGS (BA1 BA2 BA3 BA4))
(INIT-C)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA VECTOR STRUC PAIR OSET CLASS BAG)
(ADDTOVAR NLAML WORTH VIEW UP SUGG SPEC RESTRUC OPS INV INTU INT-NOT INT INIT GENL FILLIN2 FILLIN1 FILLIN EXS-NOT-BDY
EXS-NOT EXS-BDY EXS DEFN-NOT DEFN D-R CHECK2 CHECK1 CHECK ANAS ALGS)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (1060 3786 (BAG 1072 . 1121) (CLASS 1125 . 1178) (INIT-C 1182 . 3557) (OSET 3561 . 3612) (PAIR 3616
. 3667) (STRUC 3671 . 3724) (VECTOR 3728 . 3783)) (9704 13523 (ALGS 9716 . 9799) (ANAS 9803 . 9880) (CHECK 9884 .
10536) (CHECK1 10540 . 10597) (CHECK2 10601 . 10658) (D-R 10662 . 10713) (DEFN 10717 . 11163) (DEFN-NOT 11167 . 11396)
(EXS 11400 . 11451) (EXS-BDY 11455 . 11514) (EXS-NOT 11518 . 11577) (EXS-NOT-BDY 11581 . 11648) (FILLIN 11652 . 12348)
(FILLIN1 12352 . 12411) (FILLIN2 12415 . 12474) (GENL 12478 . 12531) (INIT 12535 . 12588) (INT 12592 . 12667) (INT-NOT
12671 . 12754) (INTU 12758 . 12835) (INV 12839 . 12922) (OPS 12926 . 12977) (RESTRUC 12981 . 13040) (SPEC 13044 .
13097) (SUGG 13101 . 13178) (UP 13182 . 13231) (VIEW 13235 . 13461) (WORTH 13465 . 13520)))))
STOP